home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / pasprog.EXE / ANALOG.PAS next >
Encoding:
Pascal/Delphi Source File  |  1994-03-17  |  13.2 KB  |  405 lines
  1.  
  2.  
  3. Program tinaSaat; {tina Bilgisayar, Selim S. Çelik}
  4.  
  5. uses
  6.   crt,dos,graph;
  7.  
  8. label
  9.   yeniden;
  10. const
  11.   GRAY50: FILLPATTERNTYPE=($AA,$55,$AA,$55,$AA,$55,$AA,$55);
  12.   upkey   = #200;
  13.   downkey = #208;
  14.   pgupkey = #201;
  15.   pgdnkey = #209;
  16.   leftkey = #203;
  17.   inskey  = #210;
  18.   rightkey = #205;
  19.   delkey  = #211;
  20.   cr      = #13;
  21.   esc     = #27;
  22.  
  23.  
  24. var
  25.   gd,gm,orx,ory,hx,hy,npx,npy,cx,cy,saatx,saaty,esev,sev : integer;
  26.   saat,dn,bs,bn,bt,bd,dd,ds : word;
  27.   x,nx1              : real;
  28.   ayartus,tus : char;
  29.   ayar  : boolean;
  30.   max   : byte;
  31.   ays   : array [0..2] of integer;
  32.   sonuc : string;
  33.  
  34. PROCEDURE BUTTONKOY (X,Y : INTEGER; C : STRING; R: BYTE; CH : CHAR; CRN: BYTE);
  35.  VAR
  36.    UZ : INTEGER;
  37.    YER : BYTE;
  38.  BEGIN
  39.    UZ:=8*LENGTH (C)+12;
  40.    SETCOLOR (8);
  41.    RECTANGLE (X,Y,X+UZ,Y+20);
  42.    SETFILLSTYLE (1,7);
  43.    FLOODFILL (X+5,Y+5,8);
  44.     SETCOLOR (15);
  45.     MOVETO (X+1,Y+19);
  46.     LINETO(X+1,Y+1);
  47.     LINETO (X+UZ-1,Y+1);
  48.     MOVETO (X+2,Y+18);
  49.     LINETO (X+2,Y+2);
  50.     LINETO (X+UZ-2,Y+2);
  51.     SETCOLOR (8);
  52.     MOVETO (X+2,Y+19);
  53.     LINETO (X+UZ-1,Y+19);
  54.     LINETO (X+UZ-1,Y+2);
  55.     MOVETO (X+3,Y+18);
  56.     LINETO (X+UZ-2,Y+18);
  57.     LINETO (X+UZ-2,Y+3);
  58.     SETCOLOR (R);
  59.     OUTTEXTXY (X+7,Y+7,C);
  60.     YER:=POS (CH,C);
  61.     IF YER>0 THEN BEGIN
  62.                       SETCOLOR (CRN);
  63.                       OUTTEXTXY (X+(YER*8)-1,Y+7,CH);
  64.                       END;
  65.   END;
  66.  
  67. function getkey : char;
  68. var
  69.   c : char;
  70. begin
  71.  
  72.   c := readkey;
  73.   repeat
  74.     if c = #0 then
  75.     begin
  76.       c := readkey;
  77.       if ord(c) > 127 then
  78.         c := #0
  79.       else
  80.         getkey := chr(ord(c) + 128);
  81.     end
  82.     else
  83.       getkey := c;
  84.   until c <> #0;
  85. end; { getkey }
  86.  
  87.  
  88. PROCEDURE WRITEXY (X,Y : INTEGER; C : STRING; R1,R2: BYTE);
  89. VAR
  90.    UZ : INTEGER;
  91. BEGIN
  92.    UZ:=8*LENGTH (C)+12;
  93.    SETCOLOR (8);
  94.    setviewport (x,y,x+uz,y+20,clipon);
  95.    clearviewport;
  96.    setviewport (0,0,getmaxx,getmaxy,clipon);
  97.    RECTANGLE (X,Y,X+UZ,Y+20);
  98.    SETFILLSTYLE (1,R1);
  99.    FLOODFILL (X+5,Y+5,8);
  100.  
  101.    RECTANGLE (X,Y,X+UZ,Y+20);
  102.    SETCOLOR (R2);
  103.    OUTTEXTXY (X+7,Y+7,C);
  104. END;
  105.  
  106.  
  107.                      {ana kìsìm}
  108.  
  109.  
  110. BEGIN
  111.   gd:=detect;
  112.   initgraph (gd,gm,'');
  113.   saatx:=100; { saatin orijin x koordinati }
  114.   saaty:=100; { saatin orijin y koordinati }
  115.  
  116.   setbkcolor (7); { zemin rengi mat beyaz }
  117.  
  118. yeniden:
  119.    setcolor (1);
  120.    setviewport (saatx,saaty,saatx+220,saaty+240,clipon);
  121.    clearviewport;
  122.    setviewport (0,0,getmaxx,getmaxy,clipon);
  123.    rectangle (saatx,saaty,saatx+220,saaty+240);
  124.    rectangle (saatx+2,saaty+2,saatx+218,saaty+238);
  125.    line (saatx,saaty+22,saatx+220,saaty+22);
  126.  
  127.    setfillstyle (1,15);
  128.    floodfill (saatx+5,saaty+25,1);
  129.    line (saatx,saaty+42,saatx+220,saaty+42);
  130.  
  131.    setcolor (2);
  132.    setlinestyle (solidln,0,thickwidth);
  133.    rectangle (SAATX+4,SAATY+44,SAATX+216,SAATY+236);
  134.    setlinestyle (solidln,0,normwidth);
  135.  
  136.    setcolor (12);
  137.    outtextxy (saatx+10,saaty+28,'Ayar');
  138.    line (saatx+10,saaty+37,saatx+16,saaty+37);
  139.    orx:=saatx+110; ory:=saaty+140;
  140.  
  141.    SETFILLPATTERN (GRAY50,11);
  142.    FLOODFILL (saatx+15,saaty+5,1);
  143.    BUTTONKOY (saatx+2,saaty+2,'■',1,' ',1);
  144.    WRITEXY  ( saatx+55,saaty+2,' (c) TINASOFT ',1,15);
  145.  
  146.  
  147.    putpixel (orx,ory,1);
  148.    setcolor (9);
  149.    setfillstyle (1,9);
  150.    for bs:=0 to 59 do begin { saat kadrani cizildi }
  151.      x:=124.10+(bs*0.1044);
  152.      hx:=trunc(orx+75*cos(x));
  153.      hy:=trunc(ory+75*sin(x));
  154.      putpixel (hx,hy,4);
  155.        if bs in [0,5,10,15,20,25,30,35,40,45,50,55] then bar (hx-2,hy-2,hx+2,hy+2);
  156.          { her bes dakikalik dilimler bar ile belirlendi }
  157.  
  158.     end;
  159.  
  160.      setwritemode (xorput);  { cizim modu xorput'a cevrildi}
  161.      dn:=0;
  162.      gettime (bt,bd,bs,bn);  { sistem saati tespit edildi }
  163.      setcolor (3);
  164.      x:=124.10+(bs*0.1044);
  165.      hx:=trunc(orx+75*cos(x));
  166.      hy:=trunc(ory+75*sin(x));
  167.      moveto (orx,ory);
  168.      lineto (hx,hy);
  169.  
  170.      setcolor (14);
  171.      dn:=bs;
  172.      x:=124.10+(bd*0.1044);
  173.      hx:=trunc(orx+75*cos(x));
  174.      hy:=trunc(ory+75*sin(x));
  175.      moveto (hx,hy);
  176.      nx1:=124.10+((bd+15)*0.1044);
  177.      npx:=trunc(orx+6*cos(nx1));
  178.      npy:=trunc(ory+6*sin(nx1));
  179.      lineto (npx,npy);
  180.      nx1:=124.10+((bd+30)*0.1044);
  181.      npx:=trunc(orx+18*cos(nx1));
  182.      npy:=trunc(ory+18*sin(nx1));
  183.      lineto (npx,npy);
  184.      nx1:=124.10+((bd+45)*0.1044);
  185.      npx:=trunc(orx+6*cos(nx1));
  186.      npy:=trunc(ory+6*sin(nx1));
  187.      lineto (npx,npy);
  188.      lineto (hx,hy);
  189.  
  190.      dd:=bd;
  191.      saat:=bt;
  192.      ds:=bt;
  193.      if saat>=12 then saat:=saat-12;
  194.      saat:=trunc(saat*5);
  195.      saat:=saat+trunc(bd/12);
  196.      x:=124.10+(saat*0.1044);
  197.      hx:=trunc(orx+60*cos(x));
  198.      hy:=trunc(ory+60*sin(x));
  199.      moveto (hx,hy);
  200.      nx1:=124.10+((saat+15)*0.1044);
  201.      npx:=trunc(orx+6*cos(nx1));
  202.      npy:=trunc(ory+6*sin(nx1));
  203.      lineto (npx,npy);
  204.      nx1:=124.10+((saat+30)*0.1044);
  205.      npx:=trunc(orx+15*cos(nx1));
  206.      npy:=trunc(ory+15*sin(nx1));
  207.      lineto (npx,npy);
  208.      nx1:=124.10+((saat+45)*0.1044);
  209.      npx:=trunc(orx+6*cos(nx1));
  210.      npy:=trunc(ory+6*sin(nx1));
  211.      lineto (npx,npy);
  212.      lineto (hx,hy);
  213.  
  214.  
  215.  repeat
  216.     gettime (bt,bd,bs,bn);  { her dongude sistem saati belirleniyor }
  217.      if dn<>bs then begin   { saniye son icra edilen saniyeden farkli ise}
  218.      setcolor (3);
  219.         x:=124.10+(dn*0.1044);     { saniyenin bir onceki pozisyonu tespit edildi }
  220.         hx:=trunc(orx+75*cos(x));  { saniyenin uc x koordinati belirlendi }
  221.         hy:=trunc(ory+75*sin(x));  { saniyenin uc y koordinati belirlendi }
  222.         moveto (orx,ory);          { sistem saat orijin noktalarina odaklandi }
  223.         lineto (hx,hy);            { tespit edilen koordinatina gore saniye xor edilerek silindi }
  224.  
  225.         x:=124.10+(bs*0.1044);
  226.         hx:=trunc(orx+75*cos(x)); { bir onceki islemler bu sefer cizim icin tekrarlandi }
  227.         hy:=trunc(ory+75*sin(x));
  228.         moveto (orx,ory);
  229.         lineto (hx,hy);
  230.  
  231.         dn:=bs;
  232.          setcolor (14);
  233.           if dd<>bd then begin               {yelkovan cizimleri gerceklestirildi }
  234.              x:=124.10+(dd*0.1044);
  235.              hx:=trunc(orx+75*cos(x));
  236.              hy:=trunc(ory+75*sin(x));
  237.               moveto (hx,hy);
  238.               nx1:=124.10+((dd+15)*0.1044);
  239.               npx:=trunc(orx+6*cos(nx1));
  240.               npy:=trunc(ory+6*sin(nx1));
  241.               lineto (npx,npy);
  242.               nx1:=124.10+((dd+30)*0.1044);
  243.               npx:=trunc(orx+18*cos(nx1));
  244.               npy:=trunc(ory+18*sin(nx1));
  245.               lineto (npx,npy);
  246.               nx1:=124.10+((dd+45)*0.1044);
  247.               npx:=trunc(orx+6*cos(nx1));
  248.               npy:=trunc(ory+6*sin(nx1));
  249.               lineto (npx,npy);
  250.               lineto (hx,hy);
  251.  
  252.              x:=124.10+(bd*0.1044);
  253.              hx:=trunc(orx+75*cos(x));
  254.              hy:=trunc(ory+75*sin(x));
  255.               moveto (hx,hy);
  256.               nx1:=124.10+((bd+15)*0.1044);
  257.               npx:=trunc(orx+6*cos(nx1));
  258.               npy:=trunc(ory+6*sin(nx1));
  259.               lineto (npx,npy);
  260.               nx1:=124.10+((bd+30)*0.1044);
  261.               npx:=trunc(orx+18*cos(nx1));
  262.               npy:=trunc(ory+18*sin(nx1));
  263.               lineto (npx,npy);
  264.               nx1:=124.10+((bd+45)*0.1044);
  265.               npx:=trunc(orx+6*cos(nx1));
  266.               npy:=trunc(ory+6*sin(nx1));
  267.               lineto (npx,npy);
  268.               lineto (hx,hy);
  269.  
  270.                   saat:=ds;
  271.                   if saat>=12 then saat:=saat-12;     { akrep ciziliyor }
  272.                   saat:=trunc(saat*5);
  273.                   saat:=saat+trunc(dd/12);
  274.                   x:=124.10+(saat*0.1044);
  275.                   hx:=trunc(orx+60*cos(x));
  276.                   hy:=trunc(ory+60*sin(x));
  277.                   moveto (hx,hy);
  278.                   nx1:=124.10+((saat+15)*0.1044);
  279.                   npx:=trunc(orx+6*cos(nx1));
  280.                   npy:=trunc(ory+6*sin(nx1));
  281.                   lineto (npx,npy);
  282.                   nx1:=124.10+((saat+30)*0.1044);
  283.                   npx:=trunc(orx+15*cos(nx1));
  284.                   npy:=trunc(ory+15*sin(nx1));
  285.                   lineto (npx,npy);
  286.                    nx1:=124.10+((saat+45)*0.1044);
  287.                    npx:=trunc(orx+6*cos(nx1));
  288.                    npy:=trunc(ory+6*sin(nx1));
  289.                    lineto (npx,npy);
  290.                    lineto (hx,hy);
  291.                   saat:=bt;
  292.                   if saat>=12 then saat:=saat-12;
  293.                   saat:=trunc(saat*5);
  294.                   saat:=saat+trunc(bd/12);
  295.                   x:=124.10+(saat*0.1044);
  296.                   hx:=trunc(orx+60*cos(x));
  297.                   hy:=trunc(ory+60*sin(x));
  298.                   moveto (hx,hy);
  299.                   nx1:=124.10+((saat+15)*0.1044);
  300.                   npx:=trunc(orx+6*cos(nx1));
  301.                   npy:=trunc(ory+6*sin(nx1));
  302.                   lineto (npx,npy);
  303.                   nx1:=124.10+((saat+30)*0.1044);
  304.                   npx:=trunc(orx+15*cos(nx1));
  305.                   npy:=trunc(ory+15*sin(nx1));
  306.                   lineto (npx,npy);
  307.                    nx1:=124.10+((saat+45)*0.1044);
  308.                    npx:=trunc(orx+6*cos(nx1));
  309.                    npy:=trunc(ory+6*sin(nx1));
  310.                    lineto (npx,npy);
  311.                    lineto (hx,hy);
  312.  
  313.                   ds:=bt;
  314.              dd:=bd;
  315.             end; { if dd<>bd }
  316.        end; { if dn<>bs}
  317.  
  318.      if keypressed then begin
  319.               tus:=getkey;
  320.               case tus of
  321.                   #27  : begin
  322.                            SETWRITEMODE (COPYPUT);
  323.                            closegraph;
  324.                            exit;
  325.                            end;
  326.                   #158  : begin
  327.                            ayar:=true;
  328.                            setwritemode (copyput);
  329.                            ays[0]:=bt;
  330.                            ays[1]:=bd;
  331.                            ays[2]:=bs;
  332.                            writexy (saatx+4,saaty+22,'Ayar',12,15);
  333.                            setviewport (saatx+3,saaty+44,saatx+100,saaty+70,clipon);
  334.                            clearviewport;
  335.                            setviewport (0,0,getmaxx,getmaxy,clipon);
  336.                            setcolor (8);
  337.                            rectangle (saatx+3,saaty+44,saatx+100,saaty+70);
  338.                            for sev:=0 to 2 do begin
  339.                            str (ays[sev]:2,sonuc);
  340.                            writexy (sev*32+5+saatx,saaty+46,sonuc,7,9);
  341.                            end;
  342.                            sev:=0;
  343.                            str (ays[sev]:2,sonuc);
  344.                            writexy (sev*32+5+saatx,saaty+46,sonuc,15,12);
  345.                            esev:=0;
  346.                            repeat
  347.                                 ayartus:=getkey;
  348.                                  case ayartus of
  349.                                    rightkey : begin
  350.                                            esev:=sev;
  351.                                            sev :=sev+1;
  352.                                            if sev>2 then sev:=0;
  353.                                            str (ays[esev]:2,sonuc);
  354.                                            writexy (esev*32+5+saatx,saaty+46,sonuc,7,9);
  355.                                            str (ays[sev]:2,sonuc);
  356.                                            writexy (sev*32+5+saatx,saaty+46,sonuc,15,12);
  357.                                            end;
  358.                                    leftkey : begin
  359.                                            esev:=sev;
  360.                                            sev :=sev-1;
  361.                                            if sev<0 then sev:=2;
  362.                                            str (ays[esev]:2,sonuc);
  363.                                            writexy (esev*32+5+saatx,saaty+46,sonuc,7,9);
  364.                                            str (ays[sev]:2,sonuc);
  365.                                            writexy (sev*32+5+saatx,saaty+46,sonuc,15,12);
  366.                                            end;
  367.                                    upkey : begin
  368.                                             max:=59;
  369.                                             if sev=0 then max:=24;
  370.                                             ays[sev]:=ays[sev]-1;
  371.                                               if ays[sev]<0 then ays[sev]:=max;
  372.                                               str (ays[sev]:2,sonuc);
  373.                                               writexy (sev*32+5+saatx,saaty+46,sonuc,15,12);
  374.                                              end;
  375.                                   downkey : begin
  376.                                             max:=59;
  377.                                             if sev=0 then max:=24;
  378.                                             ays[sev]:=ays[sev]+1;
  379.                                               if ays[sev]>max then ays[sev]:=0;
  380.                                               str (ays[sev]:2,sonuc);
  381.                                               writexy (sev*32+5+saatx,saaty+46,sonuc,15,12);
  382.  
  383.                                              end;
  384.                                        end;
  385.                             until ayartus in [cr,esc];
  386.                              if ayartus=cr then settime (ays[0],ays[1],ays[2],0);
  387.                            goto yeniden;
  388.                            end;
  389.                   end;
  390.  
  391.               end;
  392. until 1=2;
  393. END.
  394.  
  395.  
  396.  
  397.  
  398.  
  399.  
  400.  
  401.  
  402.  
  403.  
  404.  
  405.